Pascal Super Library/Pascal Super Library (CW International)(1997).bin/LIBRARY/PBLIB1/UNITS/PBTSTLIB.PAS

Pascal/Delphi Source File | 1994-05-03 | 6KB | 223 lines

{SECTION ..PbTSTLIB }
UNIT PbTSTLIB;

{
Description : Some Procedures for monitoring HEAP & TIME use.

Author      : Howard Richoux
Date        : 1/8/94  STARTING OVER
Last revised:
Application : IBM PC and compatibles, done in Turbo Pascal 5.5
Status      : Placed in the Public Domain by HNR Software 1/29/1994
Published in: none
}

INTERFACE

uses PbMISC;

Procedure PbTSTLIBInit;
                   {[TESTING] Initializes HEAP & TIME vars }

Procedure ShowMEM(s : string);
                   {[TESTING] Displays Heap Use }

Procedure SetMEMCurrent;
                   {[TESTING] Defines a new starting point }

Procedure TrackMEM;
                   {[TESTING] Records current conditions, for max }

Function  MEMCurrentStr(str : string) : string;
                   {[TESTING] returns string of ShowMEMCurrent }

Function  MEMChangeStr(str : string) : string;
                   {[TESTING] returns string of ShowMEMChange }

Procedure ShowMEMCurrent(str : string);
                   {[TESTING] Writeln of Heap Use since SetMEMCurrent }

Procedure ShowMEMChange(s : string);
                   {[TESTING] Writeln of Heap Use since SetMEMCurrent IF CHANGED}


var initmemavail  : longint;  {initial heap memory available to program }
var initmaxavail  : longint;  {initial maximum chunk size available     }
var memused       : longint;  {initmemavail - memavail  total used at present}
var holdmemavail  : longint;  {some later point in time }
var holdmemused   : longint;  {used since hold was reset }
var prevmemused   : longint;  {previous printed memused }
var holdmaxused   : longint;  {highest use since hold was reset}
var netchange     : longint;  {tracking }


Procedure SetTIMECurrent;
                   {[TESTING] Starts Time tracking }

Function  TIMECurrentStr(str : string) : string;
                   {[TESTING] Displays TICKS Use since SetTIMECurrent }

Procedure ShowTIMECurrent(str : string);
                   {[TESTING] Displays TIME Use }




var initticks     : longint;  {program start time ticks since midnight}
var holdticks     : longint;  {some later point in time}
var netticks      : longint;  {tracking}
var totalticks    : longint;  {since start of program}

{SECTION .zImplementation }
IMPLEMENTATION


{SECTION  TrackTIME }
Procedure TrackTIME;
     begin
     netticks   := TicksSinceMidnight - holdticks;
     totalticks := TicksSinceMidnight - initticks;
     end;


{SECTION  SetTIMECurrent }
Procedure SetTIMECurrent;
     begin
     holdticks := TicksSinceMidnight;
     netticks  := 0;
     end;


{SECTION  TIMECurrentStr }
Function  TIMECurrentStr(str : string) : string;
                   {[TESTING] Displays TICKS Use since SetTIMECurrent }
var s : string;
     begin
     TrackTIME;
     TIMECurrentStr := leftstr(str,25)+
                          ' time:'+longintstr(netticks,7)+
                          '    total:'+longintstr(totalticks,7)+
                          '   '+TicksToSecsStr(TicksSinceMidnight);
     end;


{SECTION  ShowTIMECurrent }
Procedure ShowTIMECurrent(str : string);
                   {[TESTING] Displays TIME Use }
     begin
     TrackTIME;
     writeln(TimeCurrentStr(str));
     end;




{SECTION  TrackMEM }
Procedure TrackMEM;
     begin
     holdmemused := (holdmemavail - memavail);      {could be negative}
     if holdmemused > holdmaxused then holdmaxused := holdmemused;
     netchange := holdmemused - prevmemused;
     end;


{SECTION  SetMEMCurrent }
Procedure SetMEMCurrent;
     begin
     holdmemavail := MemAvail;
     holdmemused  := 0;
     prevmemused  := 0;
     holdmaxused  := 0;
     end;


{SECTION  MEMCurrentStr }
Function  MEMCurrentStr(str : string) : string;
                   {[TESTING] Displays Heap Use since SetMEMCurrent }
var s : string;
     begin
     TrackMem;
     MEMCurrentStr := leftstr(str,25)+
                          ' used:'+longintstr(holdmemused,7)+
                          '   change:'+longintstr(netchange,7)+
                          '   maxused:'+longintstr(holdmaxused,7);
     prevmemused := holdmemused;
     end;


{SECTION  ShowMEMCurrent }
Procedure ShowMEMCurrent(str : string);
                   {[TESTING] Displays Heap Use since SetMEMCurrent }
     begin
     TrackMem;
     writeln(MemCurrentStr(str));
     end;


{SECTION  MEMChangeStr }
Function  MEMChangeStr(str : string) : string;
                   {[TESTING] Displays Heap Use since SetMEMCurrent }
var s : string;
     begin
     s := '';
     TrackMem;
     if netchange <> 0 then s := MEMCurrentStr(str);
     MEMChangeStr := s;
     end;


{SECTION  ShowMEMChange }
Procedure ShowMEMChange(s : string);
                   {[TESTING] Displays Heap Use since SetMEMCurrent IF CHANGED}
     begin
     TrackMem;
     if netchange <> 0 then ShowMEMCurrent(s);
     end;



{SECTION  ShowMEM }
Procedure ShowMEM(s : string);
                   {[TESTING] Displays Heap Use }
var netchange : longint;
     begin
     TrackMem;
     memused := initmemavail-memavail;
     writeln(leftstr(s,25),' used:',memused:7,'    Avail:',memavail:7,
                           '  MaxAvail:',maxAvail:7);
     prevmemused := holdmemused;
     end;



{SECTION  SetMEMInitial }
Procedure SetMEMInitial;
     begin
     initmemavail := memavail;
     initmaxavail := maxavail;
     SetMEMCurrent;
     end;


{SECTION  SetTIMEInitial }
Procedure SetTIMEInitial;
     begin
     initticks := TicksSinceMidnight;
     totalticks  := 0;
     SetTIMECurrent;
     end;


{SECTION  PbTSTLIBInit }
Procedure PbTSTLIBInit;
     begin
     SetMEMInitial;
     SetTIMEInitial;
     end;


{SECTION  zzInitialization }
     begin {initialization}
     PbTSTLIBInit;
     end.